home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / thread.tcl.z / thread.tcl
Text File  |  2002-07-08  |  7KB  |  280 lines
  1. # thread.tcl
  2. #
  3. #
  4. # Display FTOC messages in a threaded manner
  5. #
  6. # Ignacio Martinez        <martinez@fundesco.es>
  7. # Fundesco
  8. # Madrid, April 1996
  9. #
  10. #    5/12/96    Axel Belinfante <Axel.Belinfante@cs.utwente.nl>
  11. #        catch scan diagnostics sent to stderr (causes close to fail)
  12. #
  13.  
  14. proc Thread_PrintReplies { msg minfo off mark {indent -1} } {
  15.     upvar $minfo msginfo
  16.     global exwin ftoc
  17.  
  18.     if {$indent < 0} {
  19.     set indent 0
  20.     set blank ""
  21.     } else {
  22.     incr indent [expr [string length $mark] + 1]
  23.     set blank [format "%*s" $indent " "]
  24.     }
  25.     set maxoff [expr $ftoc(scanWidth) - 2]     ;# newline counted as well
  26.     foreach m $msginfo(refs,$msg) {
  27.         if {[lsearch $msginfo(out) $m] < 0} {
  28.             set text $msginfo(text,$m)
  29.             set tmplist [list [string range $text 0 $off] "$blank" "$mark " \
  30.                               [string range $text [expr $off + 1] end]]
  31.             set newtext [join $tmplist ""]
  32.             if {[string length $newtext] > $maxoff} {
  33.                 set newtext [string range $newtext 0 $maxoff]
  34.             }
  35.             $exwin(ftext) insert end "$newtext\n"
  36.             lappend msginfo(out) $m
  37.             Thread_PrintReplies $m msginfo $off $mark $indent
  38.         }
  39.     }
  40. }  
  41.  
  42. proc Thread_IsRel { minfo msg } {
  43.     upvar $minfo msginfo
  44.  
  45.     if {[lsearch $msginfo(selm) $msg] >= 0} {
  46.     return 1
  47.     }
  48.     foreach m $msginfo(refs,$msg) {
  49.     if [Thread_IsRel msginfo $m] {
  50.       return 1
  51.     }
  52.     }
  53.  
  54.     return 0
  55. }
  56.  
  57. proc Thread_Scan { folder minfo } {
  58.     upvar $minfo msginfo
  59.  
  60. #
  61. #  We only care about what is currently displayed into the FTOC.
  62. #  New messages are ignored.
  63. #
  64.     set maxlines   $msginfo(maxl)
  65.     set firstmsg   [Ftoc_MsgNumber 1]
  66.     set lastmsg    [Ftoc_MsgNumber $maxlines]
  67.  
  68.     set scan_fmt   "%(msg) %{message-id}%{in-reply-to}%{references}"
  69.     set scan_cmd   [list scan +$folder $firstmsg-$lastmsg \
  70.                              -noheader -noclear -width 9999 -format $scan_fmt]
  71.  
  72.     if [catch {open "|$scan_cmd"} pipe] {
  73.         Exmh_Status "scan failed: $pipe" purple
  74.         return 1
  75.     }
  76.  
  77.     set numline 0
  78.     set status "Scanning $folder for cross-references ..."
  79.     set pass [expr int($maxlines/10)]
  80.     set msginfo(hits) 0
  81.     set msginfo(tref) 0
  82.  
  83.     Exmh_Status $status blue
  84.     while {[gets $pipe line] > 0} {
  85.     set num {}
  86.     if ![regexp {^ *([0-9]+) <([^>]*)>(.*)} $line x num mid newline] {
  87.         # no message-id?
  88.         regexp {^ *([0-9]+)} $line x num
  89.         set mid {}
  90.         set newline {}
  91.     }
  92.         if {$num != [lindex $msginfo(msgs) $numline]} {
  93.             Exmh_Status "thread/scan message mismatch. Rescan?" purple
  94.             return 1
  95.         }
  96.         incr numline
  97.         if {$maxlines > 250 && [expr $numline%$pass] == 0} {
  98.             set done [expr 10*$numline/$pass]
  99.             Exmh_Status "$status $done% done" blue
  100.         }
  101.         set msginfo(refs,$num)  {}
  102.         set msginfo(isref,$num) 0
  103.         set msgnum($mid) $num
  104.         set line $newline          
  105.         while {[regexp {<([^>]*)>(.*)} $line x mid newline] == 1} {
  106.             if [info exists msgnum($mid)] {
  107.                 set ref $msgnum($mid)
  108.                 lappend msginfo(refs,$ref) $num
  109.                 set msginfo(isref,$num) 1
  110.                 incr msginfo(hits)
  111.             } else {
  112.                 if ![info exists unres($num)] {
  113.                     set unres($num) {}
  114.                 }
  115.                 lappend unres($num) $mid
  116.             }
  117.             set line $newline
  118.             incr msginfo(tref)
  119.         }
  120.     }
  121.     if [catch {close $pipe} err] {
  122.         Exmh_Status "scan diagnostic: $err" purple
  123.         # we suppose that there were only diagnostics, no need to fail...
  124.     }
  125.  
  126. #
  127. # Second round. Disordered messages (i.e. replies received BEFORE their
  128. # originals)
  129. #
  130.     foreach res [array names unres] {
  131.         foreach mid $unres($res) {
  132.            if [info exists msgnum($mid)] {
  133.                set ref $msgnum($mid)
  134.                lappend msginfo(refs,$ref) $res
  135.                set msginfo(isref,$res) 1
  136.                incr msginfo(hits)
  137.            }
  138.         }
  139.     }
  140.  
  141.     return 0
  142. }
  143.  
  144. proc Thread_Display { {breakoff 20} {mark "+->"} } {
  145.  
  146.     busy Thread_Ftoc 1 $breakoff $mark
  147. }
  148.  
  149. proc Thread_DisplayAll { {breakoff 20} {mark "+->"} } {
  150.  
  151.     busy Thread_Ftoc 0 $breakoff $mark
  152. }
  153.  
  154. proc Thread_Ftoc { {selected 0} {breakoff 20} {mark "+->"} } {
  155.     global exwin exmh ftoc msg
  156.  
  157. #
  158. #  Check that the current FTOC corresponds to a 'real folder' scan.
  159. #
  160.     if !$ftoc(displayValid) {
  161.         Exmh_Status "Already threaded or not a valid display" warn
  162.         return
  163.     }
  164.  
  165. #
  166. #  Selection activated and nothing selected, so do nothing
  167. #
  168.     if {$selected && [Ftoc_PickSize] < 1} {
  169.     Exmh_Status "You must select at least one message first" warn
  170.     return
  171.     }
  172.  
  173.     set folder     $exmh(folder)          ;#  the real folder name
  174.     set curmsg     {}                     ;#  the current message
  175.     set show       noshow                 ;#  redisplay message?
  176.  
  177. #
  178. #  Saving the current state
  179. #
  180.     if $ftoc(pickone) {
  181.         set curmsg $msg(id)
  182.         if {$msg(dpy) == $curmsg} {
  183.             set show show
  184.         }
  185.     set sellines $ftoc(curLine)
  186.     } else {
  187.     set sellines $ftoc(lineset)
  188.     }
  189.  
  190. #
  191. #  Commit pending changes. We are sort of changing folders ...
  192. #
  193.     if {[Ftoc_Changes "Change folder"] > 0} {
  194.         return
  195.     }
  196.     set maxlines   $ftoc(numMsgs)
  197.  
  198. #
  199. # Get text ASAP to speed up the whole thing
  200. #
  201.     set numline 0
  202.     set msginfo(msgs)  {}
  203.     set msginfo(selm)  {}
  204.     Exmh_Status "Getting text from the display ..." blue
  205.     while {$numline < $maxlines} {
  206.     incr numline
  207.     set text [$exwin(ftext) get $numline.0 $numline.end]
  208.     regexp {^ *([0-9]+)} $text x num
  209.     set msginfo(text,$num) $text
  210.         lappend msginfo(msgs) $num
  211.     if {[lsearch $sellines $numline] >= 0} {
  212.         lappend msginfo(selm) $num
  213.     }
  214.     }
  215.  
  216.     set msginfo(maxl) $maxlines
  217.     if {[Thread_Scan $folder msginfo] != 0} {
  218.     return
  219.     }
  220.  
  221. #
  222. # Redisplay
  223. #
  224.     Ftoc_RangeUnHighlight
  225.     Msg_CheckPoint
  226.     Msg_Reset $maxlines $folder
  227.     set ftoc(folder) {}
  228.     set ftoc(displayValid) 0    ;#  don't cache this display now
  229.     set ftoc(displayDirty) 0    ;#  but do it later if there are any changes
  230.  
  231.     set msginfo(out) {}
  232.  
  233.     Exmh_Status "Redisplaying FTOC ..." blue
  234.     $exwin(ftext) configure -state normal
  235.     $exwin(ftext) delete 0.0 end
  236.     foreach m $msginfo(msgs) {
  237.         if !$msginfo(isref,$m) {
  238.         if {!$selected || [Thread_IsRel msginfo $m]} {
  239.         $exwin(ftext) insert end "$msginfo(text,$m)\n"
  240.         lappend msginfo(out) $m
  241.         Thread_PrintReplies $m msginfo $breakoff $mark
  242.         }
  243.         }
  244.     }
  245.     $exwin(ftext) configure -state disabled
  246.  
  247.     set numseltext {}
  248.     if $selected {
  249.     set numsel [llength $msginfo(out)]
  250.     set numseltext "$numsel/"
  251.     } elseif {[llength $msginfo(out)] != $maxlines} {
  252.         Exmh_Status "folder incorrectly threaded. line number mismatch" warn
  253.     }
  254.  
  255.     Flist_ForgetUnseen $folder
  256.     Ftoc_ShowUnseen $folder
  257.  
  258.     if {$curmsg != {}} {
  259.         set msg(id) $curmsg
  260.         set ftoc(curLine) [Ftoc_FindMsg $curmsg]
  261.         Buttons_Current 1
  262.         Msg_ShowCurrent $show
  263.     } else {
  264.     if $selected {
  265.         Buttons_Current 0
  266.         Buttons_Range
  267.         Ftoc_PickMsgs $msginfo(selm) 0
  268.     } else {
  269.         Exmh_Status ok
  270.     }
  271.         Ftoc_Yview end
  272.     }
  273.     
  274.     set eff 0
  275.     if {$msginfo(tref) > 0} {
  276.         set eff [expr int(100*$msginfo(hits)/$msginfo(tref))]
  277.     }
  278.     Label_Folder {} "$folder+ $numseltext$maxlines msgs $eff% threaded"
  279. }
  280.